home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 3 / CD ACTUAL 3.iso / linux / incoming / jstools-.6v3 / jstools- / jstools-tk3.6v3.0 / lib / jedit_util.tcl < prev    next >
Encoding:
Text File  |  1995-02-09  |  11.8 KB  |  428 lines
  1. # jedit_util.tcl - utility procedures for jedit, a tk-based editor
  2. # 
  3. # Copyright 1992-1994 by Jay Sekora.  All rights reserved, except 
  4. # that this file may be freely redistributed in whole or in part 
  5. # for non-profit, noncommercial use.
  6.  
  7. # TO DO
  8. #   abbrev fixes:
  9. #     maybe some heuristics for things like plurals
  10. #     maybe a syntax for suffixes (e.g., commit;t -> commitment)
  11. #   file_modes panel
  12. #   documentation for keybindings (automatic documentation?)
  13. #   problem with filename getting set when you cancel Save 
  14. #     for the first time on a new unnamed file
  15. #   improve find panel
  16. #     have find wrap around (if last time didn't match)
  17. #     regex search/replace
  18. #     find all at once (mark) and cycle through with tag nextrange
  19. #   gesture commands
  20. #   autobreaking space a problem if you use two spaces betw sentences
  21. #   word-end punctuation (and heuristics) sd be mode-specific
  22.  
  23. # CHANGES:
  24. #   house(s) the s won't expand
  25. #   return key checkpoints!
  26. #   improved mode handling (hooks)
  27.  
  28. ######################################################################
  29.  
  30. ######################################################################
  31. # basic initialisation
  32. # only has an effect the first time it's called.
  33. ######################################################################
  34.  
  35. proc jedit:init {} {
  36.   global JEDIT_INITIALISED        ;# flag - already called?
  37.   if [info exists JEDIT_INITIALISED] {
  38.     return                ;# only initialise once
  39.   }
  40.   set JEDIT_INITIALISED 1
  41.   
  42.   global J_PREFS            ;# cross-application prefs
  43.   global JEDIT_PREFS            ;# editor prefs (all modes)
  44.   global JEDIT_MODEPREFS        ;# mode-specific prefs
  45.   
  46.   global JEDIT_WINDOW_COUNT        ;# number of toplevel windows
  47.   set JEDIT_WINDOW_COUNT 0
  48.   
  49.   j:jstools_init            ;# prefs, libraries, bindings...
  50.   
  51.   global UNDOPTR            ;# current index into undo ring
  52.   set UNDOPTR 0
  53.   
  54.   global FILE_MODES            ;# filename patterns for modes
  55.                       ;# only first two sublist items matter
  56.   set FILE_MODES {
  57.     {*.c        code        {C source}}
  58.     {*.f        code        {Fortran source}}
  59.     {*.h        code        {C header files}}
  60.     {*.jdoc        jdoc        {document for jdoc app.}}
  61.     {*.jrt        richtext    {rich-text with fonts and other tags}}
  62.     {*.p        code        {Pascal source}}
  63.     {*.sh        code        {Bourne shell script}}
  64.     {*.shar        code        {Bourne shell archive}}
  65.     {*.tcl        tcl        {Tcl scripts}}
  66.     {*.tk        tcl        {Tk/Tcl scripts}}
  67.     {*.exp        tcl        {Expect scripts}}
  68.     {*/.letter        mail        {Mail from tin}}
  69.     {.letter        mail        {Mail from tin}}
  70.     {*/.[a-zA-Z]*    code        {~/.login, etc.}}
  71.     {.[a-zA-Z]*        code        {.login, etc.}}
  72.     {*/draft*/[0-9]*    mh        {MH, exmh, xmh, etc.}}
  73.     {*/tmp/snd.[0-9]*    mail        {elm}}
  74.     {*/tmp/R*[0-9]    mail        {UCB Mail}}
  75.     {*.note        note        {short multi-font note}}
  76.   }
  77.   
  78.   global LINE_MODES            ;# first-line patterns for modes
  79.                       ;# only first two sublist items matter
  80.   set LINE_MODES {
  81.     {%!*        code        {PostScript file}}
  82.     {{#!*/wish*}    tcl        {Tk/Tcl scripts}}
  83.     {{#!*/tclsh*}    tcl        {Tcl scripts}}
  84.     {{#!*/expect*}    tcl        {Expect or Expectk scripts}}
  85.     {#!*        code        {executable script}}
  86.   }
  87.   
  88.   global WORD_END
  89.   set WORD_END {
  90.     ampersand
  91.     apostrophe
  92.     asterisk
  93.     braceright
  94.     bracketright
  95.     colon
  96.     comma
  97.     exclam
  98.     minus
  99.     parenright
  100.     period
  101.     question
  102.     quotedbl
  103.     quoteright
  104.     semicolon
  105.     slash
  106.     underscore
  107.   }
  108.   
  109.   global CUTBUFFER
  110.   set CUTBUFFER {}
  111.   
  112.   global ABBREV                ;# last abbrev expanded
  113.   set ABBREV {}
  114.   global ABBREV_POS            ;# start of last abbrev
  115.   set ABBREV_POS {}
  116.   global MATCH                ;# last match found
  117.   set MATCH {}
  118.   global MATCH_POS            ;# position of last match found
  119.   set MATCH_POS {}
  120.   global ABBREV_LIST            ;# list of abbrevs read from file
  121.   set ABBREV_LIST {}            ;# (not yet used)
  122.   global ABBREVS            ;# text-indexed array of expansions
  123. }
  124.  
  125. ######################################################################
  126. # edit a file
  127. ######################################################################
  128.  
  129. proc jedit:jedit { args } {
  130.   global JEDIT_PREFS
  131.   global JEDIT_MODEPREFS        ;# mode-specific prefs
  132.   global JEDIT_WINDOW_COUNT        ;# number of toplevel windows
  133.   
  134.   j:parse_args {
  135.     {window unspecified}
  136.     {mode default}
  137.     {file {}}
  138.   }
  139.   
  140.   jedit:init                ;# ignored second etc. time it's called
  141.   
  142.   if {"x$mode" == "xdefault"} {        ;# if caller hasn't specified mode
  143.     if {"x$file" != "x"} {        ;#   and we have a filename
  144.       set mode [jedit:guess_mode $file]    ;#     guess the mode
  145.     } else {                ;#   if no filename
  146.       set mode plain            ;#     empty window in plain mode
  147.     }
  148.   }
  149.   
  150.   # pick a window name if the user hasn't supplied one
  151.   if { "x$window" == "xunspecified" } {
  152.     set window [jedit:new_window_name]
  153.   }
  154.   
  155.   if { ! [winfo exists $window] } {
  156.     toplevel $window
  157.   }
  158.   
  159.   incr JEDIT_WINDOW_COUNT        ;# keep count of each window opened
  160.   
  161.   set text [jedit:top_to_text $window]
  162.   
  163.   if {"x$file" != "x"} {
  164.     jedit:set_filename $window $file
  165.   }
  166.   jedit:set_mode $window $mode
  167.   
  168.   jedit:userinit $window $mode $file
  169.   jedit:mkwindow $window
  170.   jedit:apply_mode $window
  171.   jedit:apply_prefs $window
  172.   
  173.   jedit:mkbindings $text $text
  174.   if {[info procs jedit:userhook] == "jedit:userhook"} {
  175.     jedit:userhook $window
  176.   }
  177.   if {"x$file" != "x"} {
  178.     tkwait visibility $text        ;# bug workaround for unpatched tk3.6
  179.     jedit:read $file $text
  180.   }
  181.   
  182.   return $window            ;# for caller to manipulate
  183. }
  184.  
  185. ######################################################################
  186. # get an unused name for a window
  187. ######################################################################
  188.  
  189. proc jedit:new_window_name {} {
  190.   set i 0
  191.   while {[winfo exists .jedit$i]} {
  192.     incr i
  193.   }
  194.   return .jedit$i
  195. }
  196.  
  197. ######################################################################
  198. # user customisation
  199. ######################################################################
  200.  
  201. proc jedit:userinit {window mode file} {
  202.   j:debug "jedit:userinit $window $mode $file"
  203.   global J_PREFS            ;# cross-application prefs
  204.   global JEDIT_MODEPREFS        ;# mode-specific prefs
  205.   global JEDIT_PREFS            ;# editor prefs (all modes)
  206.   
  207.   # read in user's editor preferences
  208.   #
  209.   j:read_prefs -array JEDIT_PREFS \
  210.     -file jedit-defaults {
  211.     {textbg white}
  212.     {textfg black}
  213.     {textsb black}
  214.     {textsf white}
  215.     {textiw 2}
  216.     {textbw 2}
  217.     {textsbw 2}
  218.     {undolevels 2}
  219.   }
  220.   jedit:read_mode_prefs $mode
  221.   jedit:cmd:read_abbrevs
  222.   
  223.   # read in user's .tk/jeditrc.tcl
  224.   j:source_config jeditrc.tcl
  225. }
  226.  
  227. ######################################################################
  228. # apply editor and mode preferences (initially or after they change)
  229. ######################################################################
  230.  
  231. proc jedit:apply_all_prefs { window } {
  232.   global JEDIT_MODEPREFS        ;# mode-specific prefs
  233.   jedit:apply_prefs $window
  234.   jedit:apply_mode $window
  235. }
  236.  
  237. ######################################################################
  238. # apply editor preferences (initially or after they change)
  239. ######################################################################
  240.  
  241. proc jedit:apply_prefs { window } {
  242.   global J_PREFS            ;# cross-application prefs
  243.   global JEDIT_MODEPREFS        ;# mode-specific prefs
  244.   global JEDIT_PREFS            ;# editor prefs (all modes)
  245.   global NAME
  246.   global HOME
  247.   global tk_strictMotif
  248.   
  249.   set text [jedit:top_to_text $window]
  250.   set menubar [jedit:top_to_menubar $window]
  251.   
  252.   # set user's text bindings:
  253.   
  254.   j:tb:init Text
  255.   j:eb:init Entry
  256.  
  257.   if {$J_PREFS(tk_strictMotif)} {
  258.     set tk_strictMotif 1
  259.   } else {
  260.     set tk_strictMotif 0
  261.   }
  262.   
  263.   # following are handled by jedit:apply_mode
  264.   # jedit:configure_text $text
  265.   # jedit:mkmenus $menubar $text
  266.   # jedit:mkbuttonbar $buttonbar $text
  267. }
  268.  
  269. ######################################################################
  270. # abbrev - set an abbreviation (used by .tk/abbrevs.tcl
  271. ######################################################################
  272.  
  273. proc abbrev {{abbrev} {expansion}} {
  274.   global ABBREVS
  275.   
  276.   set ABBREVS($abbrev) $expansion
  277. }
  278.  
  279. ######################################################################
  280. # regsub in selection in t
  281. #   if the original text ends with a newline, it is removed and
  282. #   replaced at the end.
  283. ### SHOULD BE MORE GENERAL (eg entire file)
  284. ######################################################################
  285.  
  286. proc jedit:text_regsub { t regex subst } {
  287.   if { ! [j:text:has_selection $t]} {
  288.     j:alert -text "No selection made in text."
  289.     return 1
  290.   }
  291.   
  292.   jedit:cmd:save_checkpoint $t            ;# save undo information
  293.   
  294.   set finalcr 0
  295.   
  296.   set text [selection get]
  297.   if [regexp -- "\n\$" $text] {
  298.     set text [string trimright $text "\n"]
  299.     set finalcr 1
  300.   }
  301.   
  302.   regsub -all -- $regex $text $subst result
  303.   
  304.   if $finalcr {
  305.     append result "\n"
  306.   }
  307.   
  308.   j:text:replace $t sel.first sel.last $result
  309. }
  310.  
  311. ######################################################################
  312. # pipe selection through command (and replace)
  313. #   if original text has a newline and new text doesn't, a newline
  314. #   is appended.  this is a workaround for some filters that drop the
  315. #   newline.  not perfect, but should be adequate.
  316. ######################################################################
  317.  
  318. proc jedit:pipe { t command } {
  319.   if { ! [j:text:has_selection $t]} {
  320.     j:alert -text "No selection made in text."
  321.     return 1
  322.   }
  323.   
  324.   jedit:cmd:save_checkpoint $t            ;# save undo information
  325.   
  326.   set finalcr 0
  327.   
  328.   set text [selection get]
  329.   if [regexp -- "\n\$" $text] {
  330.     set finalcr 1
  331.   }
  332.   
  333.   if { ! $finalcr } {                ;# doesn't already have newline
  334.     append text "\n"
  335.   }
  336.   
  337.   if [catch { eval exec $command << [list $text] } result] {
  338.     j:alert -text "Error from $command: $result"
  339.     return 1
  340.   }
  341.   
  342.   if {$finalcr && ( ! [regexp -- "\n\$" $result] )} {
  343.     append result "\n"
  344.   }
  345.   
  346.   j:text:replace $t sel.first sel.last $result
  347.   
  348.   return 0
  349. }
  350.  
  351. ######################################################################
  352. # return string with first char capitalised
  353. ######################################################################
  354.  
  355. proc jedit:capitalise {string} {
  356.   set cap [format {%s%s} \
  357.     [string toupper [string range $string 0 0]] \
  358.     [string range $string 1 end]]
  359.   return $cap
  360. }
  361.  
  362. ######################################################################
  363. # return string with first char lowercased
  364. ######################################################################
  365.  
  366. proc jedit:uncapitalise {string} {
  367.   set lc [format {%s%s} \
  368.     [string tolower [string range $string 0 0]] \
  369.     [string range $string 1 end]]
  370.   return $lc
  371. }
  372.  
  373. ######################################################################
  374. # go to a particular line
  375. ######################################################################
  376.  
  377. proc jedit:go_to_line { t {lineno 0} } {
  378.   set result [catch {
  379.     j:tb:move $t $lineno.0
  380.   }]
  381.   if $result then {j:alert -text "`$lineno' is not a valid line number."}
  382. }
  383.  
  384. ######################################################################
  385. # set the filename corresponding to a window.  the window can be
  386. # specified either as a text widget, or as that text widget's
  387. # corresponding toplevel window.
  388. ######################################################################
  389.  
  390. proc jedit:set_filename { w filename } {
  391.   global JEDIT_FILES
  392.   
  393.   if { [winfo class $w] == "Text" } {
  394.     set window [jedit:text_to_top $w]
  395. #    set text $w
  396.   } else {
  397.     set window $w
  398. #    set text [jedit:top_to_text $w]
  399.   }
  400.   
  401.   set JEDIT_FILES($window) $filename
  402. }
  403.  
  404. ######################################################################
  405. # return the filename corresponding to a window.  the window can be
  406. # specified either as a text widget, or as that text widget's
  407. # corresponding toplevel window.  if no filename has been set for that
  408. # window, returns {}.
  409. ######################################################################
  410.  
  411. proc jedit:get_filename { w } {
  412.   global JEDIT_FILES
  413.   
  414.   if { [winfo class $w] == "Text" } {
  415.     set window [jedit:text_to_top $w]
  416. #    set text $w
  417.   } else {
  418.     set window $w
  419. #    set text [jedit:top_to_text $w]
  420.   }
  421.   
  422.   if [info exists JEDIT_FILES($window)] {
  423.     return $JEDIT_FILES($window)
  424.   } else {
  425.     return {}
  426.   }
  427. }
  428.